perm filename INTERF.FAI[SYS,HE]2 blob
sn#184731 filedate 1975-11-04 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00017 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 ENTRY SNDPIC,INIT11,BLKCOM,FNDBLK,GETWRD,PUTWRD,IOWAIT,PUTBLK,GETBLK
C00006 00003 REGISTER DEFINITIONS
C00009 00004 SUBTTL FREWAI - PDP11 INPUT WAIT ROUTINE
C00014 00005 SUBTTL OUTWAI - PDP11 OUTPUT WAIT
C00016 00006 SUBTTL INIT11 - PDP11 INITIALIZATION ROUTINE
C00019 00007 SUBTTL PUT11 AND GET11 - PDP11 DATA TRANSFER ROUTINES
C00022 00008 SUBTTL GETWRD AND PUTWRD - GET AND PUT WORDS IN 11 MEMORY
C00023 00009 SUBTTL BLKCOM - SEND 'TRANSMIT BLOCK' COMMAND TO 11
C00026 00010 BLKCOM: SETUP IBUF,GRAB!MHALF,,2put command in 11 input buffer
C00028 00011 SUBTTL SNDPIC - SEND TV PICTURE TO 11
C00031 00012 IMULI 1,(2)
C00033 00013 LOOP: MOVE 2,10 set up two 11 words of picture elements
C00035 00014 SUBTTL FNDBLK, SNDCOM- GET BLOCK STATUS, SEND COMMAND
C00037 00015 SUBTTL COMRET - END COMMAND
C00039 00016 SUBTTL PUTBLK - TRANSFER DATA BLOCKS TO 11
C00041 00017 SUBTTL GETBLK - GET DATA BLOCK FROM 11
C00044 ENDMK
C⊗;
ENTRY SNDPIC,INIT11,BLKCOM,FNDBLK,GETWRD,PUTWRD,IOWAIT,PUTBLK,GETBLK
ENTRY SNDCOM,COMRET
MOVEC
TITLE INTER - PDP10/PDP11 INTERFACE FOR VISION PROGRAMS
SUBTTL control bits and definitions for interface
EXTERNAL TVWORD,FLINE,LLINE,RSIDE,LSIDE,LINLEN,BITS,IWID
; PDP11 PROGRAM DEFINITIONS
IBUF←←150 ; start of PDP11 input buffer (must be even)
OBUF←←160 ; start of PDP11 output buffer (must be even)
D11←←470 ; device number for PDP11 transfer box
KLKC←←772542 ; clock count register
KLKS←←772540 ; clock status register
; CONI BITS FOR DEVICE D11
IREQ←←400000 ; PDP11 requested interrupt
HALTED←←200000 ; the 11 is halted
NXM←←100000 ; no response from UNIBUS
BUSTO←←40000 ; unable to gain control of UNIBUS
;PARHI←←20000 ; bad parity
PARLO←←10000 ; bad parity
;BADBIT←←HALTED!NXM!BUSTO!PARHI!PARLO ; error conditions
BADBIT←←HALTED!NXM!BUSTO!PARLO ; error conditions
BUSY←←4000 ; transfer in progress
DONE←←2000 ; transfer done
;CONO BITS FOR DEVICE D11
SETADR←←400000 ; set address from bits 0-17, set status otherwise
RESET←←100000 ; reset interface
CLRINT←←40000 ; clears special interrupt and error conditions
IGNPAR←←20000 ; don't check for parity errors on input
STOP←←10000 ; clears BUSY and DONE and releases UNIBUS
GO←←4000 ; start input
WRITE←←2000 ; write into 11 - read from 11 otherwise
GRAB←←1000 ; hold UNIBUS continuously
EXTEND←←400 ; extend the sign bit on input
MODE←←300 ; data modes
MBYTE←←300 ; two 11 words as 32 bits left adjusted
MINT←←200 ; two 11 words as 32 bits right adjusted
MHALF←←100 ; two 11 words each right adjusted in H.W.
MONE←←000 ; one 11 word right adjusted
;PDP11 COMMAND NUMBERS
TRNBLK←←1 ; transmit block
BLKSTAT←←2 ; get block status
; REGISTER DEFINITIONS
P←←17 ; procedure linkage
INCR←11 ; address increment
ADDR←13 ; transfer address
DATA←14 ; data to transfer
HOLD←15 ; set with CONI or CONO bits as needed for transfer
; PDP10 PROGRAM DEFINITIONS
NTRY←←100 ; number of tries before wait routine gives up
;GLOBAL VARIABLES
BADCNT: 0 ; error counter
;TTY MESSAGES
WAILOS: ASCIZ .PDP11 did not respond to command.
COMLOS: ASCIZ .PDP11 responded to wrong command.
TYPMES: ASCIZ .Type <CR> to retry operation which lost.
PARERR: ASCIZ .Parity error from PDP11.
HLTERR: ASCIZ .PDP11 is halted.
BUSERR: ASCIZ .PDP11 UNIBUS does not respond.
CONERR: ASCIZ .cannot gain control of UNIBUS.
AUTO: ASCIZ .type <CR> for automatic restart of PDP11 .
WONM: ASCIZ .WE WON.
INITM: ASCIZ .attempting to reinitialize PDP11 - .
LOSEM: ASCIZ .WE LOST - restart manually.
CRLF: ASCIZ .
.
;USEFUL MACROS
DEFINE ERRSTR (MES,ADR)
{ OUTSTR CRLF
OUTSTR MES
OUTSTR CRLF
OUTSTR TYPMES
INCHWL 1
JRST ADR }
DEFINE SETUP (ADR,BITS,DAT,INC)
{ IFDIF <ADR> <> <MOVEI ADDR,ADR/2>
IFDIF <BITS> <> <MOVEI HOLD,BITS>
IFDIF <DAT> <> <MOVEI DATA,DAT>
IFDIF <INC> <> <MOVEI INCR,INC>}
DEFINE LIOTM (A)
{ IFDIF <A> <> <JRST 2,@A(P)>
IFIDN <A> <> <JRST 2,@[.+1]> }
SUBTTL FREWAI - PDP11 INPUT WAIT ROUTINE
; This routine waits until 11 is ready to accept input.
; It will attempt to restart 11 if the 11 does not go into a
; ready state and the user requestes it. BADCNT must be set with NTRY
; before first call. Returns to next location to retry I/O .
; Returns to next+1 if ok. Uses AC 1. Assumes user iot mode.
FREWAI: CONSZ D11,BUSY ;wait for BUSY flag to clear
JRST .-1
CONSZ D11,BADBIT
JRST [ CONSO D11,BUSTO!NXM
JRST XERR11 ;fatal error from 11
SOSLE BADCNT ;is count zero?
JRST XERR11 ;yes, give up
CONO D11,CLRINT ;clear interface
POPJ P,] ;return to try again
OKRET: MOVEI 1,NTRY ;OK, restore count
MOVEM 1,BADCNT
AOS (P) ;return to call+2
POPJ P,
XERR11: CONSZ D11,HALTED ;output proper error message
MOVEI 1,HLTERR
CONSZ D11,NXM
MOVEI 1,BUSERR
CONSZ D11,BUSTO
MOVEI 1,CONERR
; CONSZ D11,PARHI!PARLO
CONSZ D11,PARLO
MOVEI 1,PARERR
OUTSTR CRLF
OUTSTR (1)
ERR11: SKIP ;modified by INIT11
OUTSTR CRLF
OUTSTR AUTO
INCHWL 1
PUSHJ P,INIT11
JRST OKRET
SUBTTL OUTWAI - PDP11 OUTPUT WAIT
; This routine waits until PDP11 sets first word of output
; buffer non-zero (it is assumed that the last routine to
; send it a command cleared the word). It calls FREWAI before
; checking . Argument is count of how many ticks to wait for
; response. Returns to call+1 if timed out. Returns call+2 if
; 11 ready. Uses AC1-4. Assumes user iot mode.
OUTWAI: PUSHJ P,FREWAI ;make sure 11 is not busy
JRST .-1 ;in case of error
SETUP OBUF,MONE,,0 ;set address to output buffer
SETZM 4
RUNTIM 4, ;get current run time
REPT: PUSHJ P,GET11 ;read 11
JUMPE DATA,[ ;test word for non-zero
SETZM 2
RUNTIME 2, ;calculate number of ticks we have waited
SUB 2,4
IDIVI 2,=14
CAMLE 2,-1(P) ;if more than argument we lost
JRST WAIOUT
JRST REPT] ;otherwise try again
AOS (P) ;ready - return to call+2
WAIOUT: SUB P,[XWD 2,2]
JRST @2(P)
; This is the external call of OUTWAI for our happy users. It
; looks the same except it enters user iot mode for them.
; TRUE if ok
IOWAIT: PUSH P,-1(P) ;restack argument
EIOTM
PUSHJ P,OUTWAI
JRST [ SETZM 1
JRST .+2]
SETOM 1
LIOTM
JRST WAIOUT
SUBTTL INIT11 - PDP11 INITIALIZATION ROUTINE
; This routine resets the interface and restarts the 11 at the
; program's starting address, causing the 11 to lose all its
; data structures. It should be call for error restarts. Uses AC 1-4.
; This, of course, works only if the program in the 11 is the
; proper one and is in a runable state
INIT11: EIOTM
MOVEI 1,NTRY ;initialize BADCNT
MOVEM 1,BADCNT
OUTSTR CRLF
OUTSTR INITM
OUTSTR CRLF
MOVE 1,[JRST INITFI] ;set failure return from FREWAI
MOVEM 1,ERR11
PUSH P,HOLD ;save HOLD for calling routine
CONO D11,RESET!CLRINT!STOP!GRAB ;flush previous action
PUSHJ P,FREWAI ;wait for ready state
JRST .-2
SETUP KLKC,GRAB!MONE,1 ;set 11 clock for one tick
PUSHJ P,PUT11
SETUP OBUF,,0 ;clear output buffer flag
PUSHJ P,PUT11
SETUP IBUF
PUSHJ P,PUT11 ;reset command
SETUP KLKS,MONE,105 ;start clock counting
PUSHJ P,PUT11
MOVEI 1,1 ;wait for tick
SLEEP 1,
REINIT: PUSH P,[60]
PUSHJ P,OUTWAI
JRST [
INITLB: OUTSTR LOSEM ;lost
CALL [SIXBIT /EXIT/]
JRST REINIT]
OUTSTR WONM
OUTSTR CRLF
MOVE 1,[SKIP] ;restore FREWAI error routine
MOVEM 1,ERR11
LIOTM
POP P,HOLD ;restore HOLD for calling routine
POPJ P,
INITFI: PUSH P,HOLD ;error entry from FREWAI when called
JRST INITLB ; from INIT11
SUBTTL PUT11 AND GET11 - PDP11 DATA TRANSFER ROUTINES
; This routine sets the transfer address to ADDR and sends DATA
; to the 11. HOLD must be set to the right mode for the argument.
; HOLD should have the GRAB bit set if further words are to be
; sent. Turn it off before sending the last word. It assumes
; that the 11 is in a ready state. Uses AC 1.
; It waits until 11 has accepted data. Assumes user iot mode.
; Increment address by contents of INCR
PUT11: CONO D11,SETADR(ADDR) ;SET ADDRESS FOR TRANSFER
CONO D11,WRITE(HOLD) ;SET TRANSFER TO WRITE
DATAO D11,DATA ;AND WRITE ONE WORD
PUSHJ P,FREWAI ;MAKE SURE 11 GETS IT
JRST PUT11
ADDI ADDR,(INCR)
POPJ P,
; This routine gets data from the 11 location in ADDR and returns
; it in DATA. HOLD must be set to the right mode for the way you
; want to receive the data. HOLD should have the GRAB bit set
; if further words are to be read. It assumes that the
; 11 is in a ready state and that the 11 has data ready to send
; (if this is program output). It waits until 11 is ready
; again before returning. Uses AC1. Assumes user iot mode.
; Increment address by contents of INCR
GET11: CONO D11,SETADR(ADDR) ;SET ADDRESS FOR TRANSFER
CONO D11,GO!EXTEND(HOLD);START READ TRANSFER
PUSHJ P,FREWAI ;WAIT UNTIL FINISHED
JRST GET11
CONO D11,SETADR(ADDR) ;AVOID NXM
DATAI D11,DATA ;GET ONE WORD
PUSHJ P,FREWAI ;WAIT UNTIL READY AGAIN
JRST .-3
ADDI ADDR,(INCR)
POPJ P,
SUBTTL GETWRD AND PUTWRD - GET AND PUT WORDS IN 11 MEMORY
; These are the external calls of the above routines. They are
; passed an address. PUTWRD also get a word of data. GETWRDs value
; is the word returned. They do not grab the UNIBUS.
GETWRD: MOVE ADDR,-1(P)
ASH ADDR,-1
SETUP ,MONE
EIOTM
PUSHJ P,GET11
MOVE 1,DATA
SUB P,[XWD 2,2]
LIOTM 2
PUTWRD: MOVE ADDR,-2(P)
ASH ADDR,-1
SETUP ,MONE
MOVE DATA,-1(P)
EIOTM
PUSHJ P,PUT11
SUB P,[XWD 3,3]
LIOTM 3
SUBTTL BLKCOM - SEND 'TRANSMIT BLOCK' COMMAND TO 11
; This routine informs the 11 that the 10 has a block of data
; to be intergrated into its data structure. The arguments of
; the command are: (each in a full 11 word)
; command name
; new block ID (procedure argument 1)
; old block ID (procedure argument 2)
; # of words to be transfered (procedure argument 3)
; If the new block ID is not >0, there is no new block and only
; deletion is possible; otherwise the new block is added to the
; data structure if there is room after garbage collecting as
; necessary. If the old block ID is >0, it will be deleted from
; the structure unless it is exactly the same size as the new block,
; in which case it will replace it. The 11 returns three words of
; information as follows; (each in a full 11 word)
; command name
; address of start of block (transfer data starting here)
; error code
; If the address is zero, there is a fatal error condition and no
; data should be transmitted. Otherwise a non-zero error code
; signifies warnings. This routine returns the address in argument 4
; and the error codes in AC 1. The error codes (ORed together) are
; 1 not enough room for new block (fatal)
; 2 block length was zero or negative (fatal)
; ignored for deletions only.
; 4 new block ID already exists (fatal)
; if new ID=old ID, this error will not occur
; 10 old block ID does not exist (warning)
; old ID not deleted if this error occurs
; 20 both IDs were zero (warning)
BLKCOM: SETUP IBUF,GRAB!MHALF,,2;put command in 11 input buffer
HRLZI DATA,TRNBLK
HRR DATA,-4(P) ;and first argument
EIOTM
PUSHJ P,PUT11
HRLZ DATA,-3(P) ;and next two argument
HRR DATA,-2(P)
PUSHJ P,PUT11
PUSH P,[TRNBLK]
PUSHJ P,CHECK ;wait for response
SETUP ,MHALF
PUSHJ P,GET11 ;get last 2 words
HLREM DATA,@-1(P) ;save address
HRRE 1,DATA ;and return as value of procedure
SUB P,[XWD 5,5]
LIOTM 5
; Waits for response to command and checks it. Argument is command
; which has sent. Returns with first return argument in DATA and
; ADDR contains OBUF+2. Assumes in user iot mode.
CHECK: SETUP OBUF,MONE,0 ;signal 11 we want it
PUSHJ P,PUT11
LAB1: PUSH P,[10] ;wait for a response
PUSHJ P,OUTWAI
JRST [ ERRSTR WAILOS,LAB1] ;did not respond
CAME DATA,-1(P) ;check for right command
JRST [ ERRSTR COMLOS,BLKCOM] ;wrong
AOS ADDR ;OUTWAI does not increment this
SUB P,[XWD 2,2]
JRST @2(P)
SUBTTL SNDPIC - SEND TV PICTURE TO 11
; This procedure attempts to send the TV picture defined by TVWORD and
; the control words to the 11. The first argument is the address to
; begin the transfer and the second is non-zero to hold the UNIBUS. The
; next four arguments are the limits of the portion of the picture to
; be transmitted: top, bottom, left, right. They will be set to the
; limit of the picture, if they are outside it. Number of words
; transfered is 8 + (bottom-top+1) * (right-left +1) / FOO where
; FOO=(if BITS≤4 then 4 else 2). No check is made to determine if the
; data block being transfered to is valid and long enough. Format of
; picture is as follows (in full words) :
; 1 index from here of start of picture data in bytes (16)
; 2 picture size in PDP11 bytes
; 3 X coordinate of upper left corner
; 4 Y coordinate of upper left corner
; 5 samples per line
; 6 number of lines
; 7 bits/sample
; 8 (11) words/line
; 9 start of picture (1 sample per byte,BITS>4;2 otherwise)
SNDPIC: MOVE 1,FLINE ;check limits of picture
CAMLE 1,-4(P)
MOVEM 1,-4(P)
MOVE 1,LLINE
CAMGE 1,-3(P)
MOVEM 1,-3(P)
MOVE 1,LSIDE
CAMLE 1,-2(P)
MOVEM 1,-2(P)
MOVE 1,RSIDE
CAMGE 1,-1(P)
MOVEM 1,-1(P)
MOVE 1,-3(P) ;calculate # of 11 words needed for PIC
SUB 1,-4(P)
MOVEI 1,1(1)
MOVEM 1,LINES# ; number of lines
MOVE 2,-1(P)
SUB 2,-2(P)
MOVEI 2,1(2)
MOVEM 2,WID#
MOVEI 2,1(2) ; number of bytes/line
ASH 2,-1 ; convert to words rounded up
MOVE 3,BITS
CAIG 3,4
JRST [ MOVEI 2,1(2) ; and again for small samples
ASH 2,-1
JRST .+1]
IMULI 1,(2)
ASH 1,1 ; convert to bytes
MOVEM 1,PICNUM#
MOVE ADDR,-6(P)
ASH ADDR,-1 ;set up transmission
SETUP ,MHALF,,2 ;two words at a time
SKIPE -5(P) ;hold bus if requested
ORI HOLD,GRAB
HRLI DATA,=16 ; picture index
HRR DATA,PICNUM ; picture size
EIOTM
PUSHJ P,PUT11
HRL DATA,-2(P) ; X coord of upper left corner
HRR DATA,-4(P) ; Y coord of upper left corner
PUSHJ P,PUT11
HRL DATA,WID ; samples per line
HRR DATA,LINES ; number of lines
PUSHJ P,PUT11
HRL DATA,BITS ; bits per sample
HRRI DATA,(2) ; words/line
PUSHJ P,PUT11
; LOOP TO OUTPUT PICTURE TO 11
ORI HOLD,MBYTE ;back to bytes
MOVE 5,[POINT 4,0] ;create byte pointer
DPB 3,[POINT 6,5,11]
HRR 5,TVWORD
ADDI 5,1
MOVE 6,-4(P) ;and adjust to start of window
SUB 6,FLINE
IMUL 6,LINLEN
ADD 5,6
MOVE 6,-2(P)
SUB 6,LSIDE
MOVEI 7,44
IDIVI 7,(3)
IDIVI 6,(7)
ADDI 5,(6)
SOJL 7,.+3
IBP 5
JRST .-2
MOVEM 5,PTR#
MOVE 7,LINES ;line count
MOVE 6,WID ;byte count
CAILE 3,4
JRST [ MOVE 10,[POINT 8,DATA]
MOVEI 3,2
JRST LOOP]
MOVE 10,[POINT 4,DATA]
MOVEI 3,4
LOOP: MOVE 2,10 ;set up two 11 words of picture elements
PUSHJ P,SETUPX
JUMPLE 6,[ ; only 1st word left in this line
PUSHJ P,ADJ ; update for next line
SOJG 7,NEXT ; check for end of picture
LSH DATA,-24 ; none - output last word
SETUP ,MONE
PUSHJ P,PUT11
JRST TRAOUT]
NEXT: PUSHJ P,SETUPX
PUSHJ P,PUT11 ;output two words
JUMPG 6,LOOP
PUSHJ P,ADJ
SOJG 7,LOOP
SKIPE -1(P)
CONO D11,STOP ; done - release 11 if holding
TRAOUT: SUB P,[XWD 7,7]
LIOTM 7
ADJ: MOVE 5,PTR ;update for next line
ADD 5,LINLEN
MOVEM 5,PTR
MOVE 6,WID
POPJ P,
SETUPX: MOVEI 4,(3) ;repack picture for 11
ILDB 1,5
IDPB 1,2
SOJG 4,.-2
SUBI 6,(3)
POPJ P,
SUBTTL FNDBLK, SNDCOM- GET BLOCK STATUS, SEND COMMAND
; This routine is given a block ID and gets from the 11 the
; address where data starts in the block and its length. If
; the block does not exists, the address and length are 0.
FNDBLK: SETUP IBUF,GRAB!MHALF ;put command in 11 input buffer
HRLZI DATA,BLKSTAT ;with one argument
HRR DATA,-3(P) ; block ID is arg 1
EIOTM
PUSHJ P,PUT11
PUSH P,[BLKSTAT]
PUSHJ P,CHECK ;wait for response
SETUP ,MHALF
PUSHJ P,GET11 ;get last 2 words
HLREM DATA,@-2(P) ;return address
HRREM DATA,@-1(P)
SUB P,[XWD 4,4]
LIOTM 4
; This routine is given a command and sends it to the 11.
; The command is argument 1. One argument for the command is
; argument 2. The routine assumes the rest of the arguments
; have been sent already. It does not wait for a response.
SNDCOM: SETUP IBUF,MHALF!GRAB
HRL DATA,-2(P)
HRR DATA,-1(P)
EIOTM
PUSHJ P,PUT11
SETUP OBUF,MONE,0
PUSHJ P,PUT11
SUB P,[XWD 3,3]
LIOTM 3
SUBTTL COMRET - END COMMAND
; This routine waits for command completion and returns the
; results. The routine is TRUE if the command completed
; in the time allowed, FALSE otherwise. The arguments to
; it are:
; 1 number of ticks max. to wait for completion
; 2 the command number is returned here
; 3 the first data word is returned here
; 4 the second data word is returned here
COMRET: PUSH P,-4(P) ;wait for completion
EIOTM
PUSHJ P,OUTWAI
JRST [ SETZM 1
JRST COMOUT] ;did not complete
MOVEM DATA,@-3(P) ;command
AOS ADDR
SETUP ,MHALF
PUSHJ P,GET11 ;get next two words
HLREM DATA,@-2(P)
HRREM DATA,@-1(P)
SETOM 1 ;value is true
COMOUT: SUB P,[XWD 5,5]
LIOTM 5
SUBTTL PUTBLK - TRANSFER DATA BLOCKS TO 11
; This routine send a data block to the 11. Arg 1 is the 11
; address where the first word is to be sent. Arg 2 is the address
; of the first word of the array containing the data. Arg 3 is the
; number of words of data to be sent. Arg 4 is non-zero to hold the
; bus. The 11 data block is assumed to be correct. Uses AC 1, 2, 3
PUTBLK:
MOVE 2,-2(P) ;count
MOVE 3,-3(P) ;start of data
MOVE ADDR,-4(P) ;11 address
ASH ADDR,-1
SETUP ,MHALF,,2
SKIPE -1(P)
ORI HOLD,GRAB
EIOTM
PUTLOP: SUBI 2,2
JUMPG 2,.+3 ;set up HOLD for end conditions
MOVEI HOLD,MHALF
JUMPL 2,[
MOVEI HOLD,MONE
MOVE DATA,(3)
JRST PUTONE]
HRL DATA,(3)
HRR DATA,1(3)
MOVEI 3,2(3)
PUTONE: PUSHJ P,PUT11
JUMPG 2,PUTLOP
SUB P,[XWD 5,5]
LIOTM 5
SUBTTL GETBLK - GET DATA BLOCK FROM 11
; This routine gets a data block from the 11. Arg 1 is the 11
; address where the first word will be found. Arg 2 is the
; address of the first word of the array to receive the block.
; Arg 3 is the number of words to get. Arg 4 is non-zero to hold
; the bus. The 11 data block is assumed to be correct. Uses AC 1,2,3
GETBLK: MOVE 2,-2(P) ;count
MOVE 3,-3(P) ;start of data
MOVE ADDR,-4(P) ;11 address
ASH ADDR,-1
SETUP ,MHALF,,2
SKIPE -1(P)
ORI HOLD,GRAB
EIOTM
GETLOP: SUBI 2,2
JUMPG 2,.+4 ;set up HOLD for end conditions
MOVEI HOLD,MHALF
JUMPE 2,.+2
MOVEI HOLD,MONE
PUSHJ P,GET11
JUMPL 2,[
MOVEM DATA,(3)
JRST GETONE]
HLREM DATA,(3)
HRREM DATA,1(3)
MOVEI 3,2(3)
GETONE: JUMPG 2,GETLOP
SUB P,[XWD 5,5]
LIOTM 5
LIT
VAR
END